home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-04 / bipl.zip / PROCS.ZIP / FINDRE.ICN < prev    next >
Text File  |  1993-01-27  |  21KB  |  709 lines
  1. ########################################################################
  2. #    
  3. #    File:     findre.icn
  4. #    
  5. #    Subject:  Procedures to find regular expression
  6. #    
  7. #    Author:   Richard L. Goerwitz
  8. #
  9. #    Date:     June 1, 1991
  10. #
  11. #######################################################################
  12. #
  13. #    Version:  1.14
  14. #
  15. ###########################################################################
  16. #
  17. #    findre() is like the Icon builtin function find(),
  18. #  except that it takes, as its first argument, a regular expression
  19. #  pretty much like the ones the UNIX egrep command uses (the few
  20. #  minor differences are listed below).  Its syntax is the same as
  21. #  find's (i.e. findre(s1,s2,i,j)), with the exception that a no-
  22. #  argument invocation wipes out all static structures utilized by
  23. #  findre, and then forces a garbage collection.
  24. #
  25. #  (For those not familiar with regular expressions and the UNIX egrep
  26. #  command: findre() offers a simple and compact wildcard-based search
  27. #  system.  If you do a lot of searches through text files, or write
  28. #  programs which do searches based on user input, then findre is a
  29. #  utility you might want to look over.)
  30. #
  31. #  Important differences between find and findre:  As noted above,
  32. #  findre() is just a find() function that takes a regular expression
  33. #  as its first argument.  One major problem with this setup is that
  34. #  it leaves the user with no easy way to tab past a matched
  35. #  substring, as with
  36. # 
  37. #    s ? write(tab(find("hello")+5))
  38. #
  39. #  In order to remedy this intrinsic deficiency, findre() sets the
  40. #  global variable __endpoint to the first position after any given
  41. #  match occurs.  Use this variable with great care, preferably
  42. #  assigning its value to some other variable immediately after the
  43. #  match (for example, findre("hello [.?!]*",s) & tmp := __endpoint).
  44. #  Otherwise, you will certainly run into trouble.  (See the example
  45. #  below for an illustration of how __endpoint is used).
  46. #
  47. #  Important differences between egrep and findre:  findre utilizes
  48. #  the same basic language as egrep.  The only big difference is that
  49. #  findre uses intrinsic Icon data structures and escaping conven-
  50. #  tions rather than those of any particular UNIX variant.  Be care-
  51. #  ful!  If you put findre("\(hello\)",s) into your source file,
  52. #  findre will treat it just like findre("(hello)",s).  If, however,
  53. #  you enter '\(hello\)' at run-time (via, say, findre(!&input,s)),
  54. #  what Icon receives will depend on your operating system (most
  55. #  likely, a trace will show "\\(hello\\)").
  56. #
  57. #  Bugs:  Space has essentially been conserved at the expense of time
  58. #  in the automata produced by findre().  The algorithm, in other
  59. #  words, will produce the equivalent of a pushdown automaton under
  60. #  certain circumstances, rather than strive (at the expense of space)
  61. #  for full determinism.  I tried to make up a nfa -> dfa converter
  62. #  that would only create that portion of the dfa it needed to accept
  63. #  or reject a string, but the resulting automaton was actually quite
  64. #  slow (if anyone can think of a way to do this in Icon, and keep it
  65. #  small and fast, please let us all know about it).  Note that under
  66. #  version 8 of Icon, findre takes up negligible storage space, due to
  67. #  the much improved hashing algorithm.  I have not tested it under
  68. #  version 7, but I would expect it to use up quite a bit more space
  69. #  in that environment.
  70. #
  71. #  Important note:  findre takes a shortest-possible-match approach
  72. #  to regular expressions.  In other words, if you look for "a*",
  73. #  findre will not even bother looking for an "a."  It will just match
  74. #  the empty string.  Without this feature, findre would perform a bit
  75. #  more slowly.  The problem with such an approach is that often the
  76. #  user will want to tab past the longest possible string of matched
  77. #  characters (say tab((findre("a*|b*"), __endpoint)).  In circumstan-
  78. #  ces like this, please just use something like:
  79. #
  80. #      s ? {
  81. #          tab(find("a")) &  # or use Arb() from the IPL (patterns.icn)
  82. #          tab(many('a'))
  83. #          tab(many('b'))
  84. #      }
  85. #
  86. #  or else use some combination of findre and the above.
  87. #    
  88. ########################################################################
  89. #
  90. #  Regular expression syntax: Regular expression syntax is complex,
  91. #  and yet simple.  It is simple in the sense that most of its power
  92. #  is concentrated in about a dozen easy-to-learn symbols.  It is
  93. #  complex in the sense that, by combining these symbols with
  94. #  characters, you can represent very intricate patterns.
  95. #
  96. #  I make no pretense here of offering a full explanation of regular
  97. #  expressions, their usage, and the deeper nuances of their syntax.
  98. #  As noted above, this should be gleaned from a UNIX manual.  For
  99. #  quick reference, however, I have included a brief summary of all
  100. #  the special symbols used, accompanied by an explanation of what
  101. #  they mean, and, in some cases, of how they are used (most of this
  102. #  is taken from the comments prepended to Jerry Nowlin's Icon-grep
  103. #  command, as posted a couple of years ago):
  104. #
  105. #     ^   -  matches if the following pattern is at the beginning
  106. #            of a line (i.e. ^# matches lines beginning with "#")
  107. #     $   -  matches if the preceding pattern is at the end of a line
  108. #     .   -  matches any single character
  109. #     +   -  matches from 1 to any number of occurrences of the
  110. #            previous expression (i.e. a character, or set of paren-
  111. #            thesized/bracketed characters)
  112. #     *   -  matches from 0 to any number of occurrences of the previous
  113. #            expression
  114. #     \   -  removes the special meaning of any special characters
  115. #            recognized by this program (i.e if you want to match lines
  116. #            beginning with a "[", write ^\[, and not ^[)
  117. #     |   -  matches either the pattern before it, or the one after
  118. #            it (i.e. abc|cde matches either abc or cde)
  119. #     []  -  matches any member of the enclosed character set, or,
  120. #            if ^ is the first character, any nonmember of the
  121. #            enclosed character set (i.e. [^ab] matches any character
  122. #         _except_ a and b).
  123. #     ()  -  used for grouping (e.g. ^(abc|cde)$ matches lines consist-
  124. #            ing of either "abc" or "cde," while ^abc|cde$ matches
  125. #            lines either beginning with "abc" or ending in "cde")
  126. #
  127. #########################################################################
  128. #
  129. #  Example program:
  130. #
  131. #  procedure main(a)
  132. #      while line := !&input do {
  133. #          token_list := tokenize_line(line,a[1])
  134. #          every write(!token_list)
  135. #      }
  136. #  end
  137. #
  138. #  procedure tokenize_line(s,sep)
  139. #      tmp_lst := []
  140. #      s ? {
  141. #          while field := tab(findre(sep)|0) &
  142. #          mark := __endpoint
  143. #          do {
  144. #              put(tmp_lst,"" ~== field)
  145. #              if pos(0) then break
  146. #              else tab(mark)
  147. #          }
  148. #      }
  149. #      return tmp_lst
  150. #  end
  151. #
  152. #  The above program would be compiled with findre (e.g. "icont
  153. #  test_prg.icn findre.icn") to produce a single executable which
  154. #  tokenizes each line of input based on a user-specified delimiter.
  155. #  Note how __endpoint is set soon after findre() succeeds.  Note
  156. #  also how empty fields are excluded with "" ~==, etc.  Finally, note
  157. #  that the temporary list, tmp_lst, is not needed.  It is included
  158. #  here merely to illustrate one way in which tokens might be stored.
  159. #
  160. #  Tokenizing is, of course, only one of many uses one might put
  161. #  findre to.  It is very helpful in allowing the user to construct
  162. #  automata at run-time.  If, say, you want to write a program that
  163. #  searches text files for patterns given by the user, findre would be
  164. #  a perfect utility to use.  Findre in general permits more compact
  165. #  expression of patterns than one can obtain using intrinsic Icon
  166. #  scanning facilities.  Its near complete compatibility with the UNIX
  167. #  regexp library, moreover, makes for greater ease of porting,
  168. #  especially in cases where Icon is being used to prototype C code.
  169. #
  170. #########################################################################
  171.  
  172. global state_table, parends_present, slash_present
  173. global biggest_nonmeta_str, __endpoint
  174. record o_a_s(op,arg,state)
  175.  
  176.  
  177. procedure findre(re, s, i, j)
  178.  
  179.     local p, x, nonmeta_len
  180.     static FSTN_table, STRING_table
  181.     initial {
  182.     FSTN_table := table()
  183.     STRING_table := table()
  184.     }
  185.  
  186.     if /re then {
  187.     FSTN_table := table()
  188.     STRING_table := table()
  189.     collect()  # do it *now*
  190.     return
  191.     }
  192.  
  193.     /s := &subject
  194.     if \i then {
  195.     if i < 1 then
  196.         i := *s + (i+1)
  197.     }
  198.     else i := \&pos | 1
  199.     if \j then {
  200.     if j < 1 then
  201.         j := *s + (j+1)
  202.     }
  203.  
  204.     else j := *s+1
  205.     if /FSTN_table[re] then {
  206.     # If we haven't seen this re before, then...
  207.     if \STRING_table[re] then {
  208.         # ...if it's in the STRING_table, use plain find()
  209.         every p := find(STRING_table[re],s,i,j)
  210.         do { __endpoint := p + *STRING_table[re]; suspend p }
  211.         fail
  212.     }
  213.     else {
  214.         # However, if it's not in the string table, we have to
  215.         # tokenize it and check for metacharacters.  If it has
  216.         # metas, we create an FSTN, and put that into FSTN_table;
  217.         # otherwise, we just put it into the STRING_table.
  218.         tokenized_re := tokenize(re)
  219.         if 0 > !tokenized_re then {
  220.         # if at least one element is < 0, re has metas
  221.         MakeFSTN(tokenized_re) | err_out(re,2)
  222.         # both biggest_nonmeta_str and state_table are global
  223.         /FSTN_table[re] := [.biggest_nonmeta_str, copy(state_table)]
  224.         }
  225.         else {
  226.         # re has no metas; put the input string into STRING_table
  227.         # for future reference, and execute find() at once
  228.         tmp := ""; every tmp ||:= char(!tokenized_re)
  229.         insert(STRING_table,re,tmp)
  230.         every p := find(STRING_table[re],s,i,j)
  231.         do { __endpoint := p + *STRING_table[re]; suspend p }
  232.         fail
  233.         }
  234.     }
  235.     }
  236.  
  237.  
  238.     if nonmeta_len := (1 < *FSTN_table[re][1]) then {
  239.     # If the biggest non-meta string in the original re
  240.     # was more than 1, then put in a check for it...
  241.     s[1:j] ? {
  242.         tab(x := i to j - nonmeta_len) &
  243.         (find(FSTN_table[re][1]) | fail) \ 1 &
  244.         (__endpoint := apply_FSTN(&null,FSTN_table[re][2])) &
  245.         (suspend x)
  246.     }
  247.     }
  248.     else {
  249.     #...otherwise it's not worth worrying about the biggest nonmeta str
  250.     s[1:j] ? {
  251.         tab(x := i to j) &
  252.         (__endpoint := apply_FSTN(&null,FSTN_table[re][2])) &
  253.         (suspend x)
  254.     }
  255.     }
  256.  
  257. end
  258.  
  259.  
  260.  
  261. procedure apply_FSTN(ini,tbl)
  262.  
  263.     static s_tbl
  264.     local POS, tmp, fin
  265.  
  266.     /ini := 1 & s_tbl := tbl & biggest_pos := 1
  267.     if ini = 0 then {
  268.     return &pos
  269.     }
  270.     POS := &pos
  271.     fin := 0
  272.  
  273.     repeat {
  274.     if tmp := !s_tbl[ini] &
  275.         tab(tmp.op(tmp.arg))
  276.     then {
  277.         if tmp.state = fin
  278.         then return &pos
  279.         else ini := tmp.state
  280.     }
  281.     else (&pos := POS, fail)
  282.     }
  283.  
  284. end
  285.     
  286.  
  287.  
  288. procedure tokenize(s)
  289.  
  290.     local chr, tmp
  291.  
  292.     token_list := list()
  293.     s ? {
  294.     tab(many('*+?|'))
  295.     while chr := move(1) do {
  296.         if chr == "\\"
  297.         # it can't be a metacharacter; remove the \ and "put"
  298.         # the integer value of the next chr into token_list
  299.         then put(token_list,ord(move(1))) | err_out(s,2,chr)
  300.         else if any('*+()|?.$^',chr)
  301.         then {
  302.         # Yuck!  Egrep compatibility stuff.
  303.         case chr of {
  304.             "*"    : {
  305.             tab(many('*+?'))
  306.             put(token_list,-ord("*"))
  307.             }
  308.             "+"    : {
  309.             tmp := tab(many('*?+')) | &null
  310.             if upto('*?',\tmp)
  311.             then put(token_list,-ord("*"))
  312.             else put(token_list,-ord("+"))
  313.             }
  314.             "?"    : {
  315.             tmp := tab(many('*?+')) | &null
  316.             if upto('*+',\tmp)
  317.             then put(token_list,-ord("*"))
  318.             else put(token_list,-ord("?"))
  319.             }
  320.             "("    : {
  321.             tab(many('*+?'))
  322.             put(token_list,-ord("("))
  323.             }
  324.             default: {
  325.             put(token_list,-ord(chr))
  326.             }
  327.         }
  328.         }
  329.         else {
  330.         case chr of {
  331.             # More egrep compatibility stuff.
  332.             "["    : {
  333.             b_loc := find("[") | *&subject+1
  334.             every next_one := find("]",,,b_loc)
  335.             \next_one ~= &pos | err_out(s,2,chr)
  336.             put(token_list,-ord(chr))
  337.             }
  338.                     "]"    : {
  339.             if &pos = (\next_one+1)
  340.             then put(token_list,-ord(chr)) &
  341.                  next_one := &null
  342.             else put(token_list,ord(chr))
  343.             }
  344.             default: put(token_list,ord(chr))
  345.         }
  346.         }
  347.     }
  348.     }
  349.  
  350.     token_list := UnMetaBrackets(token_list)
  351.  
  352.     fixed_length_token_list := list(*token_list)
  353.     every i := 1 to *token_list
  354.     do fixed_length_token_list[i] := token_list[i]
  355.     return fixed_length_token_list
  356.  
  357. end
  358.  
  359.  
  360.  
  361. procedure UnMetaBrackets(l)
  362.  
  363.     # Since brackets delineate a cset, it doesn't make
  364.     # any sense to have metacharacters inside of them.
  365.     # UnMetaBrackets makes sure there are no metacharac-
  366.     # ters inside of the braces.
  367.  
  368.     local tmplst, i, Lb, Rb
  369.  
  370.     tmplst := list(); i := 0
  371.     Lb := -ord("[")
  372.     Rb := -ord("]")
  373.  
  374.     while (i +:= 1) <= *l do {
  375.     if l[i] = Lb then {
  376.         put(tmplst,l[i])
  377.         until l[i +:= 1] = Rb
  378.         do put(tmplst,abs(l[i]))
  379.         put(tmplst,l[i])
  380.     }
  381.     else put(tmplst,l[i])
  382.     }
  383.     return tmplst
  384.  
  385. end
  386.  
  387.  
  388.  
  389. procedure MakeFSTN(l,INI,FIN)
  390.  
  391.     # MakeFSTN recursively descends through the tree structure
  392.     # implied by the tokenized string, l, recording in (global)
  393.     # fstn_table a list of operations to be performed, and the
  394.     # initial and final states which apply to them.
  395.  
  396.     # global biggest_nonmeta_str, slash_present, parends_present
  397.     static Lp, Rp, Sl, Lb, Rb, Caret_inside, Dot, Dollar, Caret_outside
  398.     local i, inter, inter2, tmp
  399.     initial {
  400.     Lp := -ord("("); Rp := -ord(")")
  401.     Sl := -ord("|")
  402.     Lb := -ord("["); Rb := -ord("]"); Caret_inside := ord("^")
  403.     Dot := -ord("."); Dollar := -ord("$"); Caret_outside := -ord("^")
  404.     }
  405.  
  406.     /INI := 1 & state_table := table() &
  407.     NextState("new") & biggest_nonmeta_str := ""
  408.     /FIN := 0
  409.  
  410.     # I haven't bothered to test for empty lists everywhere.
  411.     if *l = 0 then {
  412.     /state_table[INI] := []
  413.     put(state_table[INI],o_a_s(zSucceed,&null,FIN))
  414.     return
  415.     }
  416.  
  417.     # HUNT DOWN THE SLASH (ALTERNATION OPERATOR)
  418.     every i := 1 to *l do {
  419.     if l[i] = Sl & tab_bal(l,Lp,Rp) = i then {
  420.         if i = 1 then err_out(l,2,char(abs(l[i]))) else {
  421.         /slash_present := "yes"
  422.         inter := NextState()
  423.         inter2:= NextState()
  424.         MakeFSTN(l[1:i],inter2,FIN)
  425.         MakeFSTN(l[i+1:0],inter,FIN)
  426.         /state_table[INI] := []
  427.         put(state_table[INI],o_a_s(apply_FSTN,inter2,0))
  428.         put(state_table[INI],o_a_s(apply_FSTN,inter,0))
  429.         return
  430.         }
  431.     }
  432.     }
  433.  
  434.     # HUNT DOWN PARENTHESES
  435.     if l[1] = Lp then {
  436.     i := tab_bal(l,Lp,Rp) | err_out(l,2,"(")
  437.     inter := NextState()
  438.     if any('*+?',char(abs(0 > l[i+1]))) then {
  439.         case l[i+1] of {
  440.         -ord("*")   : {
  441.             /state_table[INI] := []
  442.             put(state_table[INI],o_a_s(apply_FSTN,inter,0))
  443.             MakeFSTN(l[2:i],INI,INI)
  444.             MakeFSTN(l[i+2:0],inter,FIN)
  445.             return
  446.         }
  447.         -ord("+")   : {
  448.             inter2 := NextState()
  449.             /state_table[inter2] := []
  450.             MakeFSTN(l[2:i],INI,inter2)
  451.             put(state_table[inter2],o_a_s(apply_FSTN,inter,0))
  452.             MakeFSTN(l[2:i],inter2,inter2)
  453.             MakeFSTN(l[i+2:0],inter,FIN)
  454.             return
  455.         }
  456.         -ord("?")   : {
  457.             /state_table[INI] := []
  458.             put(state_table[INI],o_a_s(apply_FSTN,inter,0))
  459.             MakeFSTN(l[2:i],INI,inter)
  460.             MakeFSTN(l[i+2:0],inter,FIN)
  461.             return
  462.         }
  463.         }
  464.     }
  465.     else {
  466.         MakeFSTN(l[2:i],INI,inter)
  467.         MakeFSTN(l[i+1:0],inter,FIN)
  468.         return
  469.     }
  470.     }
  471.     else {     # I.E. l[1] NOT = Lp (left parenthesis as -ord("("))
  472.     every i := 1 to *l do {
  473.         case l[i] of {
  474.         Lp     : {
  475.             inter := NextState()
  476.             MakeFSTN(l[1:i],INI,inter)
  477.             /parends_present := "yes"
  478.             MakeFSTN(l[i:0],inter,FIN)
  479.             return
  480.         }
  481.         Rp     : err_out(l,2,")")
  482.         }
  483.     }
  484.     }
  485.  
  486.     # NOW, HUNT DOWN BRACKETS
  487.     if l[1] = Lb then {
  488.     i := tab_bal(l,Lb,Rb) | err_out(l,2,"[")
  489.     inter := NextState()
  490.     tmp := ""; every tmp ||:= char(l[2 to i-1])
  491.     if Caret_inside = l[2]
  492.     then tmp := ~cset(Expand(tmp[2:0]))
  493.     else tmp :=  cset(Expand(tmp))
  494.     if any('*+?',char(abs(0 > l[i+1]))) then {
  495.         case l[i+1] of {
  496.         -ord("*")   : {
  497.             /state_table[INI] := []
  498.             put(state_table[INI],o_a_s(apply_FSTN,inter,0))
  499.             put(state_table[INI],o_a_s(any,tmp,INI))
  500.             MakeFSTN(l[i+2:0],inter,FIN)
  501.             return
  502.         }
  503.         -ord("+")   : {
  504.             inter2 := NextState()
  505.             /state_table[INI] := []
  506.             put(state_table[INI],o_a_s(any,tmp,inter2))
  507.             /state_table[inter2] := []
  508.             put(state_table[inter2],o_a_s(apply_FSTN,inter,0))
  509.             put(state_table[inter2],o_a_s(any,tmp,inter2))
  510.             MakeFSTN(l[i+2:0],inter,FIN)
  511.             return
  512.         }
  513.         -ord("?")   : {
  514.             /state_table[INI] := []
  515.             put(state_table[INI],o_a_s(apply_FSTN,inter,0))
  516.             put(state_table[INI],o_a_s(any,tmp,inter))
  517.             MakeFSTN(l[i+2:0],inter,FIN)
  518.             return
  519.         }
  520.         }
  521.     }
  522.     else {
  523.         /state_table[INI] := []
  524.         put(state_table[INI],o_a_s(any,tmp,inter))
  525.         MakeFSTN(l[i+1:0],inter,FIN)
  526.         return
  527.     }
  528.     }
  529.     else {           # I.E. l[1] not = Lb
  530.     every i := 1 to *l do {
  531.         case l[i] of {
  532.         Lb     : {
  533.             inter := NextState()
  534.             MakeFSTN(l[1:i],INI,inter)
  535.             MakeFSTN(l[i:0],inter,FIN)
  536.             return
  537.         }
  538.         Rb     : err_out(l,2,"]")
  539.         }
  540.     }
  541.     }
  542.  
  543.     # FIND INITIAL SEQUENCES OF POSITIVE INTEGERS, CONCATENATE THEM
  544.     if i := match_positive_ints(l) then {
  545.     inter := NextState()
  546.     tmp := Ints2String(l[1:i])
  547.     # if a slash has been encountered already, forget optimizing
  548.         # in this way; if parends are present, too, then forget it,
  549.         # unless we are at the beginning or end of the input string
  550.     if  INI = 1 | FIN = 2 | /parends_present &
  551.         /slash_present & *tmp > *biggest_nonmeta_str
  552.     then biggest_nonmeta_str := tmp
  553.     /state_table[INI] := []
  554.     put(state_table[INI],o_a_s(match,tmp,inter))
  555.     MakeFSTN(l[i:0],inter,FIN)
  556.     return
  557.     }
  558.  
  559.     # OKAY, CLEAN UP ALL THE JUNK THAT'S LEFT
  560.     i := 0
  561.     while (i +:= 1) <= *l do {
  562.     case l[i] of {
  563.         Dot          : { Op := any;   Arg := &cset }
  564.         Dollar       : { Op := pos;   Arg := 0     }
  565.         Caret_outside: { Op := pos;   Arg := 1     }
  566.         default      : { Op := match; Arg := char(0 < l[i]) }
  567.     } | err_out(l,2,char(abs(l[i])))
  568.     inter := NextState()
  569.     if any('*+?',char(abs(0 > l[i+1]))) then {
  570.         case l[i+1] of {
  571.         -ord("*")   : {
  572.             /state_table[INI] := []
  573.             put(state_table[INI],o_a_s(apply_FSTN,inter,0))
  574.             put(state_table[INI],o_a_s(Op,Arg,INI))
  575.             MakeFSTN(l[i+2:0],inter,FIN)
  576.             return
  577.         }
  578.         -ord("+")   : {
  579.             inter2 := NextState()
  580.             /state_table[INI] := []
  581.             put(state_table[INI],o_a_s(Op,Arg,inter2))
  582.             /state_table[inter2] := []
  583.             put(state_table[inter2],o_a_s(apply_FSTN,inter,0))
  584.             put(state_table[inter2],o_a_s(Op,Arg,inter2))
  585.             MakeFSTN(l[i+2:0],inter,FIN)
  586.             return
  587.         }
  588.         -ord("?")   : {
  589.             /state_table[INI] := []
  590.             put(state_table[INI],o_a_s(apply_FSTN,inter,0))
  591.             put(state_table[INI],o_a_s(Op,Arg,inter))
  592.             MakeFSTN(l[i+2:0],inter,FIN)
  593.             return
  594.         }
  595.         }
  596.     }
  597.     else {
  598.         /state_table[INI] := []
  599.         put(state_table[INI],o_a_s(Op,Arg,inter))
  600.         MakeFSTN(l[i+1:0],inter,FIN)
  601.         return
  602.     }
  603.     }
  604.  
  605.     # WE SHOULD NOW BE DONE INSERTING EVERYTHING INTO state_table
  606.     # IF WE GET TO HERE, WE'VE PARSED INCORRECTLY!
  607.     err_out(l,4)
  608.  
  609. end
  610.  
  611.  
  612.  
  613. procedure NextState(new)
  614.     static nextstate
  615.     if \new then nextstate := 1
  616.     else nextstate +:= 1
  617.     return nextstate
  618. end
  619.  
  620.  
  621.  
  622. procedure err_out(x,i,elem)
  623.     writes(&errout,"Error number ",i," parsing ",image(x)," at ")
  624.     if \elem 
  625.     then write(&errout,image(elem),".")
  626.     else write(&errout,"(?).")
  627.     exit(i)
  628. end
  629.  
  630.  
  631.  
  632. procedure zSucceed()
  633.     return .&pos
  634. end
  635.  
  636.  
  637.  
  638. procedure Expand(s)
  639.  
  640.     s2 := ""
  641.     s ? {
  642.     s2 ||:= ="^"
  643.     s2 ||:= ="-"
  644.     while s2 ||:= tab(find("-")-1) do {
  645.         if (c1 := move(1), ="-",
  646.         c2 := move(1),
  647.         c1 << c2)
  648.         then every s2 ||:= char(ord(c1) to ord(c2))
  649.         else s2 ||:= 1(move(2), not(pos(0))) | err_out(s,2,"-")
  650.     }
  651.     s2 ||:= tab(0)
  652.     }
  653.     return s2
  654.  
  655. end
  656.  
  657.  
  658.  
  659. procedure tab_bal(l,i1,i2)
  660.     i := 0
  661.     i1_count := 0; i2_count := 0
  662.     while (i +:= 1) <= *l do {
  663.     case l[i] of {
  664.         i1  : i1_count +:= 1
  665.         i2  : i2_count +:= 1
  666.     }
  667.     if i1_count = i2_count
  668.     then suspend i
  669.     }
  670. end
  671.  
  672.  
  673. procedure match_positive_ints(l)
  674.     
  675.     # Matches the longest sequence of positive integers in l,
  676.     # beginning at l[1], which neither contains, nor is fol-
  677.     # lowed by a negative integer.  Returns the first position
  678.     # after the match.  Hence, given [55, 55, 55, -42, 55],
  679.     # match_positive_ints will return 3.  [55, -42] will cause
  680.     # it to fail rather than return 1 (NOTE WELL!).
  681.  
  682.     every i := 1 to *l do {
  683.     if l[i] < 0
  684.     then return (3 < i) - 1 | fail
  685.     }
  686.     return *l + 1
  687.  
  688. end
  689.  
  690.  
  691. procedure Ints2String(l)
  692.     tmp := ""
  693.     every tmp ||:= char(!l)
  694.     return tmp
  695. end
  696.  
  697.  
  698. procedure StripChar(s,s2)
  699.     if find(s2,s) then {
  700.     tmp := ""
  701.     s ? {
  702.         while tmp ||:= tab(find("s2"))
  703.         do tab(many(cset(s2)))
  704.         tmp ||:= tab(0)
  705.     }
  706.     }
  707.     return \tmp | s
  708. end
  709.